home *** CD-ROM | disk | FTP | other *** search
/ Whiteline: Alpha / Whiteline Alpha.iso / progtool / modula2 / hk_lib / def_mod / chars.mod < prev    next >
Encoding:
Modula Implementation  |  1994-09-22  |  38.9 KB  |  1,190 lines
  1. IMPLEMENTATION MODULE  Chars;
  2.  
  3. (*****************************************************************************)
  4. (* Kommentar siehe Definitionsmodul, die Prozeduren erklaeren sich wohl von  *)
  5. (* selbst. Geplant ist eine Optimierung in Assembler, deshalb bauen die Pro- *)
  6. (* zeduren nicht aufeinander auf, ausserdem wirds so schneller...            *)
  7. (*                                                                           *)
  8. (* Ich gestehs: Die Geschwindigkeitssteigerung durch Assemblercodierung haelt*)
  9. (* sich, da hier keine Schleifen mit zeitaufwendigen Indexoperationen verwen-*)
  10. (* det werden, in engen Grenzen ( 10 - 30% ); wer also die saubere Modula-   *)
  11. (* Variante vorzieht: bitte! Es muessen nur die Assemblerteile aus- und die  *)
  12. (* Modula-Teile entkommentiert werden.                                       *)
  13. (*                                                                           *)
  14. (* Bei der Uebersetzung ist zu beachten, dass der Testmodus ausgeschaltet    *)
  15. (* bleibt, wenn die Assemblerversionen benutzt werden sollen, da sonst Lauf- *)
  16. (* zeitfehler auftreten ( 'Funktionsprozedur ohne RETURN' ).                 *)
  17. (* Falls das griech. Beta anstatt des Sz verwendet werden soll, so muss die  *)
  18. (* entsprechende Konstante auch in den Assemblerteilen geaendert werden      *)
  19. (* ( siehe entsprechende Hinweise, einfach die INLINE's austauschen ) !      *)
  20. (*___________________________________________________________________________*)
  21. (*                                                                           *)
  22. (* 08-Sep-89 , hk                                                            *)
  23. (*       Begonnen                                                            *)
  24. (* 17-Sep-89 , hk                                                            *)
  25. (*       Erste Version                                                       *)
  26. (* 23-Sep-89 , hk                                                            *)
  27. (*       Prozeduren: IsPrintable, IsWhitespace, IsControl,                   *)
  28. (*                   SZ nur kleiner Umlaut                                   *)
  29. (* 14-Okt-89 , hk                                                            *)
  30. (*       Konstanten EOL und EOS nicht mehr definiert,                        *)
  31. (*       IsWhitespace -> IsSpace, VTab zaehlt dazu                           *)
  32. (*       Konstanten: VTab, ASCII-Umlaute, Paragraph;                         *)
  33. (*       Typen:      CharClassTest, CharConvert                              *)
  34. (*       Prozeduren: Tests auf ASCII-Umlaute und ASCII-Deutsch,              *)
  35. (*                   IsHexDigit, IsPunctuation, IsGraphic, IsASCII           *)
  36. (*                   Konvertieren ASCII <-> Atari, Klein <-> Gross.          *)
  37. (* 18-Okt-89 , hk                                                            *)
  38. (*       Die meisten Prozeduren in Assembler                                 *)
  39. (* 07-Dez-89 , hk                                                            *)
  40. (*       Assemblerteile bei "IsUmlaut","IsGerman" so geaendert, dass die     *)
  41. (*       INLINE-Befehle fuer SZ nur ausgetauscht zu werden brauchen          *)
  42. (* 05-Jan-90 , hk                                                            *)
  43. (*       "IsBinDigit", "IsOctDigit" neu                                      *)
  44. (* 23-Jan-90 , hk                                                            *)
  45. (*       "HexDigitToCard", "CardToHexDigit" neu                              *)
  46. (* 05-Feb-90 , hk                                                            *)
  47. (*       saemtliche CHAR-Konstanten aus "ASCII" importieren                  *)
  48. (* 12-Feb-90 , hk                                                            *)
  49. (*       "IsPrintable", "IsGraphic" auch fuer Zeichen > 7FH,                 *)
  50. (*       "IsDelimiter" neu                                                   *)
  51. (*****************************************************************************)
  52.  
  53.  
  54. FROM  SYSTEM  IMPORT  (* PROC *)  VAL, INLINE;
  55.  
  56. FROM  ASCII   IMPORT  (* CONST*)  NUL, DEL, HT, CR,
  57.                                   kleinesAE, kleinesOE, kleinesUE, SZ, Beta,
  58.                                   grossesAE, grossesOE, grossesUE, Paragraph,
  59.                                   kleinesASCIIae, kleinesASCIIoe,
  60.                                   kleinesASCIIue, ASCIIsz, ASCIIParagraph,
  61.                                   grossesASCIIae, grossesASCIIoe,
  62.                                   grossesASCIIue;
  63.  
  64. (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
  65.  
  66.    VAR  LcAtari,                        (* siehe Modulinitialisierung *)
  67.         UcAtari   : ARRAY [0..3]  OF CHAR;
  68.  
  69.         hexdigits : ARRAY [0..15] OF CHAR;
  70.  
  71. (*===========================================================================*)
  72.  
  73. PROCEDURE  IsASCII ((* EIN/ -- *)  zeichen : CHAR ): BOOLEAN;
  74. (*T*)
  75.    BEGIN
  76.      RETURN( zeichen <= DEL);
  77.    END  IsASCII;
  78.  
  79. (* --------------------------------------------------------------------------*)
  80.  
  81. PROCEDURE  IsControl ((* EIN/ -- *)  zeichen : CHAR ): BOOLEAN;
  82. (*T*)
  83.    BEGIN
  84.      RETURN(( zeichen < ' ' ) OR ( zeichen = DEL ));
  85.    END  IsControl;
  86.  
  87. (* --------------------------------------------------------------------------*)
  88.  
  89. PROCEDURE  IsPrintable ((* EIN/ -- *)  zeichen : CHAR ): BOOLEAN;
  90. (*T*)
  91.    BEGIN
  92.      RETURN(( ' ' <= zeichen )  &  ( zeichen # DEL ));
  93.    END  IsPrintable;
  94.  
  95. (* --------------------------------------------------------------------------*)
  96.  
  97. PROCEDURE  IsGraphic ((* EIN/ -- *)  zeichen : CHAR ): BOOLEAN;
  98. (*T*)
  99.    BEGIN
  100.      RETURN(( ' ' < zeichen )  &  ( zeichen # DEL ));
  101.    END  IsGraphic;
  102.  
  103. (* --------------------------------------------------------------------------*)
  104.  
  105. PROCEDURE  IsSpace ((* EIN/ -- *) zeichen : CHAR ): BOOLEAN;
  106. (*T*)
  107.    BEGIN
  108. (*   RETURN(( zeichen = ' '                        )  OR
  109.             (( HT <= zeichen ) & ( zeichen <= CR ) )      );
  110.  
  111.      zeichen EQU  12
  112.      RETURN  EQU  zeichen + 2
  113.  
  114.      IsSpace:
  115.        moveq   #0, d1           ; Default = FALSE
  116.        move.b  zeichen(a6), d0
  117.        cmpi.b  #' ', d0         ; zeichen = ' ' ?
  118.        beq.s   true             ; B: ja, Space
  119.        subi.b  #$09, d0         ; zeichen >= HT ?
  120.        blo.s   ende             ; B: nein, kein Space
  121.        subq.b  #$0D-$09, d0     ; zeichen <= CR ?
  122.        bhi.s   ende             ; B: nein, kein Space
  123.      true:
  124.        moveq   #1, d1
  125.      ende:
  126.        move.b  d1, RETURN(a6)
  127. *)
  128.      INLINE( 7200H );
  129.      INLINE( 102EH,000CH );
  130.      INLINE( 0C00H,0020H );
  131.      INLINE( 670AH );
  132.      INLINE( 0400H,0009H );
  133.      INLINE( 6506H );
  134.      INLINE( 5900H );
  135.      INLINE( 6202H );
  136.      INLINE( 7201H );
  137.      INLINE( 1D41H,000EH );
  138.    END  IsSpace;
  139.  
  140. (* --------------------------------------------------------------------------*)
  141.  
  142. PROCEDURE  IsBinDigit ((* EIN/ -- *) zeichen : CHAR ): BOOLEAN;
  143. (*T*)
  144.    BEGIN
  145.      RETURN(( '0' = zeichen ) OR ( zeichen = '1' ));
  146.    END  IsBinDigit;
  147.  
  148. (* --------------------------------------------------------------------------*)
  149.  
  150. PROCEDURE  IsOctDigit ((* EIN/ -- *) zeichen : CHAR ): BOOLEAN;
  151. (*T*)
  152.    BEGIN
  153.      RETURN(( '0' <= zeichen ) & ( zeichen <= '7' ));
  154.    END  IsOctDigit;
  155.  
  156. (* --------------------------------------------------------------------------*)
  157.  
  158. PROCEDURE  IsDigit ((* EIN/ -- *)  zeichen : CHAR ): BOOLEAN;
  159. (*T*)
  160.    BEGIN
  161.      RETURN(( '0' <= zeichen ) & ( zeichen <= '9' ));
  162.    END  IsDigit;
  163.  
  164. (* --------------------------------------------------------------------------*)
  165.  
  166. PROCEDURE  IsHexDigit ((* EIN/ -- *)  zeichen : CHAR ): BOOLEAN;
  167. (*T*)
  168.    BEGIN
  169. (*   RETURN((( '0' <= zeichen ) & ( zeichen <= '9' )) OR
  170.             (( 'A' <= zeichen ) & ( zeichen <= 'F' )) OR
  171.             (( 'a' <= zeichen ) & ( zeichen <= 'f' )));
  172.  
  173.      zeichen  EQU  12
  174.      RETURN   EQU  zeichen + 2
  175.  
  176.      IsHexDigit:
  177.        moveq    #0, d1          ; Default: FALSE
  178.        move.b   zeichen(a6), d0 ; fuer schnellen Zugriff
  179.        cmpi.b   #'0', d0        ; zeichen >= '0' ?
  180.        blo.s    ende            ; B: nein, kein Digit
  181.        cmpi.b   #'9', d0        ; zeichen <= '9' ?
  182.        bls.s    true            ; B: ja, Ziffer
  183.        andi.b   #%11011111, d0  ; A = a
  184.        subi.b   #'A', d0        ; zeichen >= 'A' ?
  185.        blo.s    return          ; B: nein, kein Digit
  186.        subq.b   #'F'-'A', d0    ; zeichen <= 'F' ?
  187.        bhi.s    ende            ; B: nein, kein Digit
  188.      true:
  189.        moveq    #1, d1          ; sonst TRUE
  190.      ende:
  191.        move.b   d1, RETURN(a6)
  192. *)
  193.      INLINE( 7200H );
  194.      INLINE( 102EH,000CH );
  195.      INLINE( 0C00H,0030H );
  196.      INLINE( 6516H );
  197.      INLINE( 0C00H,0039H );
  198.      INLINE( 630EH );
  199.      INLINE( 0200H,00DFH );
  200.      INLINE( 0400H,0041H );
  201.      INLINE( 6506H );
  202.      INLINE( 5B00H );
  203.      INLINE( 6202H );
  204.      INLINE( 7201H );
  205.      INLINE( 1D41H,000EH );
  206.    END  IsHexDigit;
  207.  
  208. (* --------------------------------------------------------------------------*)
  209.  
  210. PROCEDURE  IsPunctuation ((* EIN/ -- *)  zeichen : CHAR ): BOOLEAN;
  211. (*T*)
  212.    BEGIN
  213. (*   RETURN((( ' ' < zeichen ) & ( zeichen < '0' )) OR
  214.             (( '9' < zeichen ) & ( zeichen < 'A' )) OR
  215.             (( 'Z' < zeichen ) & ( zeichen < 'a' )) OR
  216.             (( 'z' < zeichen ) & ( zeichen < DEL )));
  217.  
  218.      zeichen  EQU  12
  219.      RETURN   EQU  zeichen + 2
  220.  
  221.      IsPunctuation:
  222.        moveq   #0, d1
  223.        move.b  zeichen(a6), d0
  224.        cmpi.b  #$7F, d0        ; zeichen < DEL ?
  225.        bhs.s   ende            ; B: nein, nicht Special
  226.        cmpi.b  #' ', d0        ; zeichen >= ' ' ?
  227.        bls.s   ende            ; B: nein
  228.        cmpi.b  #'0', d0        ; zeichen < '0' ?
  229.        blo.s   true            ; B: ja, ...
  230.        cmpi.b  #'9', d0        ; '0' <= zeichen <= '9' ?
  231.        bls.s   ende            ; B: ja, Digit nicht special
  232.        andi.b  #%11011111, d0  ; A = a
  233.        cmpi.b  #'A', d0        ; zeichen = Buchstabe ?
  234.        blo.s   true            ; B: nein, special
  235.        cmpi.b  #'Z', d0        ; zeichen = Buchstabe ?
  236.        bls.s   ende            ; B: ja, kein special
  237.      true:
  238.        moveq   #1, d1
  239.      ende:
  240.        move.b  d1, RETURN(a6)
  241. *)
  242.      INLINE( 7200H );
  243.      INLINE( 102EH,000CH );
  244.      INLINE( 0C00H,007FH );
  245.      INLINE( 6424H );
  246.      INLINE( 0C00H,0020H );
  247.      INLINE( 631EH );
  248.      INLINE( 0C00H,0030H );
  249.      INLINE( 6516H );
  250.      INLINE( 0C00H,0039H );
  251.      INLINE( 6312H );
  252.      INLINE( 0200H,00DFH );
  253.      INLINE( 0C00H,0041H );
  254.      INLINE( 6506H );
  255.      INLINE( 0C00H,005AH );
  256.      INLINE( 6302H );
  257.      INLINE( 7201H );
  258.      INLINE( 1D41H,000EH );
  259.    END  IsPunctuation;
  260.  
  261. (* --------------------------------------------------------------------------*)
  262.  
  263. PROCEDURE  IsDelimiter ((* EIN/ -- *)  zeichen : CHAR ): BOOLEAN;
  264. (*T*)
  265.    BEGIN
  266. (*   RETURN((            zeichen < '0'            ) OR
  267.             (( '9' < zeichen ) & ( zeichen < 'A' )) OR
  268.             (( 'Z' < zeichen ) & ( zeichen < 'a' )) OR
  269.             (( 'z' < zeichen ) & ( zeichen <=DEL )));
  270.  
  271.      zeichen  EQU  12
  272.      RETURN   EQU  zeichen + 2
  273.  
  274.      IsDelimiter:
  275.        moveq   #0, d1
  276.        move.b  zeichen(a6), d0
  277.        cmpi.b  #$7F, d0        ; zeichen < DEL ?
  278.        bhi.s   ende            ; B: nein, nicht Special
  279.        cmpi.b  #'0', d0        ; zeichen < '0' ?
  280.        blo.s   true            ; B: ja, ...
  281.        cmpi.b  #'9', d0        ; '0' <= zeichen <= '9' ?
  282.        bls.s   ende            ; B: ja, Digit nicht special
  283.        andi.b  #%11011111, d0  ; A = a
  284.        cmpi.b  #'A', d0        ; zeichen = Buchstabe ?
  285.        blo.s   true            ; B: nein, special
  286.        cmpi.b  #'Z', d0        ; zeichen = Buchstabe ?
  287.        bls.s   ende            ; B: ja, kein special
  288.      true:
  289.        moveq   #1, d1
  290.      ende:
  291.        move.b  d1, RETURN(a6)
  292. *)
  293.      INLINE( 7200H );
  294.      INLINE( 102EH,000CH );
  295.      INLINE( 0C00H,007FH );
  296.      INLINE( 621EH );
  297.      INLINE( 0C00H,0030H );
  298.      INLINE( 6516H );
  299.      INLINE( 0C00H,0039H );
  300.      INLINE( 6312H );
  301.      INLINE( 0200H,00DFH );
  302.      INLINE( 0C00H,0041H );
  303.      INLINE( 6506H );
  304.      INLINE( 0C00H,005AH );
  305.      INLINE( 6302H );
  306.      INLINE( 7201H );
  307.      INLINE( 1D41H,000EH );
  308.    END  IsDelimiter;
  309.  
  310. (* --------------------------------------------------------------------------*)
  311.  
  312. PROCEDURE  IsSmallLetter ((* EIN/ -- *)  zeichen : CHAR ): BOOLEAN;
  313. (*T*)
  314.    BEGIN
  315.      RETURN(( 'a' <= zeichen ) & ( zeichen <= 'z' ));
  316.    END  IsSmallLetter;
  317.  
  318. (* --------------------------------------------------------------------------*)
  319.  
  320. PROCEDURE  IsBigLetter ((* EIN/ -- *)  zeichen : CHAR ): BOOLEAN;
  321. (*T*)
  322.    BEGIN
  323.      RETURN(( 'A' <= zeichen ) & ( zeichen <= 'Z' ));
  324.    END  IsBigLetter;
  325.  
  326. (* --------------------------------------------------------------------------*)
  327.  
  328. PROCEDURE  IsLetter ((* EIN/ -- *)  zeichen : CHAR ): BOOLEAN;
  329. (*T*)
  330.    BEGIN
  331. (*
  332.      RETURN(( 'A' <= zeichen ) & ( zeichen <= 'Z' ) OR
  333.             ( 'a' <= zeichen ) & ( zeichen <= 'z' ));
  334.  
  335.      zeichen  EQU  12
  336.      RETURN   EQU  zeichen + 2
  337.  
  338.      IsLetter:
  339.        moveq    #0, d1          ; Default: FALSE
  340.        move.b   zeichen(a6), d0 ; fuer schnellen Zugriff
  341.        andi.b   #%11011111, d0  ; A = a
  342.        cmpi.b   #'A', d0        ; zeichen < 'A' ?
  343.        blo.s    return          ; B: ja, kein Buchstabe
  344.        cmpi.b   #'Z', d0        ; zeichen > 'Z' ?
  345.        bhi.s    return          ; B: ja, kein Buchstabe
  346.        moveq    #1, d1          ; sonst TRUE
  347.      return:
  348.        move.b   d1, RETURN(a6)
  349. *)
  350.      INLINE( 7200H );
  351.      INLINE( 102EH, 000CH );
  352.      INLINE( 0200H, 00DFH );
  353.      INLINE( 0C00H, 0041H );
  354.      INLINE( 6508H );
  355.      INLINE( 0C00H, 005AH );
  356.      INLINE( 6202H );
  357.      INLINE( 7201H );
  358.      INLINE( 1D41H, 000EH );
  359.    END  IsLetter;
  360.  
  361. (* --------------------------------------------------------------------------*)
  362.  
  363. PROCEDURE  IsAlphanumeric ((* EIN/ -- *)  zeichen : CHAR ): BOOLEAN;
  364. (*T*)
  365.    BEGIN
  366. (*
  367.      RETURN(( 'A' <= zeichen ) & ( zeichen <= 'Z' ) OR
  368.             ( 'a' <= zeichen ) & ( zeichen <= 'z' ) OR
  369.             ( '0' <= zeichen ) & ( zeichen <= '9' ));
  370.  
  371.      zeichen  EQU  12
  372.      RETURN   EQU  zeichen + 2
  373.  
  374.      IsAlphanumeric:
  375.        moveq    #0, d1          ; Default: FALSE
  376.        move.b   zeichen(a6), d0 ; fuer scnellen Zugriff
  377.        cmpi.b   #'0', d0        ; zeichen < '0' ?
  378.        blo.s    return          ; B: ja, weder Zahl noch Buchstabe
  379.        cmpi.b   #'9', d0        ; zeichen <= '9' ?
  380.        bls.s    true            ; B: ja, Zahl, also alphanumerisch
  381.        andi.b   #%11011111, d0  ; A = a
  382.        cmpi.b   #'A', d0        ; zeichen < 'A' ?
  383.        blo.s    return          ; B: ja, weder Buchstabe noch Zahl
  384.        cmpi.b   #'Z', d0        ; zeichen > 'Z' ?
  385.        bhi.s    return          ; B: ja, weder Buchstabe noch Zahl
  386.      true:
  387.        moveq    #1, d1          ; sonst alphanumerisch
  388.      return:
  389.        move.b   d1, RETURN(a6)
  390. *)
  391.      INLINE( 7200H );
  392.      INLINE( 102EH, 000CH );
  393.      INLINE( 0C00H, 0030H );
  394.      INLINE( 6518H );
  395.      INLINE( 0C00H, 0039H );
  396.      INLINE( 6310H );
  397.      INLINE( 0200H, 00DFH );
  398.      INLINE( 0C00H, 0041H );
  399.      INLINE( 6508H );
  400.      INLINE( 0C00H, 005AH );
  401.      INLINE( 6202H );
  402.      INLINE( 7201H );
  403.      INLINE( 1D41H, 000EH );
  404.    END  IsAlphanumeric;
  405.  
  406. (* --------------------------------------------------------------------------*)
  407.  
  408. PROCEDURE  IsSmallUmlaut ((* EIN/ -- *)  zeichen : CHAR ): BOOLEAN;
  409. (*T*)
  410.    BEGIN
  411. (*   RETURN(( zeichen = kleinesAE ) OR
  412.             ( zeichen = kleinesOE ) OR
  413.             ( zeichen = kleinesUE ) OR
  414.             ( zeichen = SZ        ));
  415.  
  416.      zeichen  EQU  12
  417.      RETURN   EQU  zeichen + 2
  418.  
  419.      IsSmallUmlaut:
  420.        moveq    #0, d1          ; Default: FALSE
  421.        move.b   zeichen(a6), d0 ; fuer schnellen Zugriff
  422.        subi.b   #'ü', d0        ; zeichen = ü ?
  423.        blo.s    return          ; B: ueberhaupt kein Umlaut
  424.        beq.s    true            ; B: ist ü
  425.        subq.b   #'ä'-'ü', d0    ; zeichen = ä ?
  426.        beq.s    true            ; B: jo
  427.        subi.b   #'ö'-'ä', d0    ; zeichen = ö ?
  428.        beq.s    true            ; B: ja
  429.        subi.b   #'ß'-'ö', d0    ; zeichen = ß ?  *** subi.b #$E1-'ö', d0 *
  430.        bne.s    return          ; kein Umlaut
  431.      true:
  432.        moveq    #1, d1          ; ist kleiner Umlaut
  433.      return:
  434.        move.b   d1, RETURN(a6)
  435. *)
  436.      INLINE( 7200H );
  437.      INLINE( 102EH, 000CH );
  438.      INLINE( 0400H, 0081H );
  439.      INLINE( 6514H );
  440.      INLINE( 6710H );
  441.      INLINE( 5700H );
  442.      INLINE( 670CH );
  443.      INLINE( 0400H, 0010H );
  444.      INLINE( 6706H );
  445.      INLINE( 0400H, 000AH ); (*** INLINE( 0400H, 004DH ); *)
  446.      INLINE( 6602H );
  447.      INLINE( 7201H );
  448.      INLINE( 1D41H, 000EH );
  449.    END  IsSmallUmlaut;
  450.  
  451. (* --------------------------------------------------------------------------*)
  452.  
  453. PROCEDURE  IsBigUmlaut ((* EIN/ -- *)  zeichen : CHAR ): BOOLEAN;
  454. (*T*)
  455.    BEGIN
  456.      RETURN(( zeichen = grossesAE ) OR
  457.             ( zeichen = grossesOE ) OR
  458.             ( zeichen = grossesUE ));
  459.    END  IsBigUmlaut;
  460.  
  461. (* --------------------------------------------------------------------------*)
  462.  
  463. PROCEDURE  IsUmlaut ((* EIN/ -- *)  zeichen : CHAR ): BOOLEAN;
  464. (*T*)
  465.    BEGIN
  466. (*   RETURN(( zeichen = kleinesAE ) OR
  467.             ( zeichen = kleinesOE ) OR
  468.             ( zeichen = kleinesUE ) OR
  469.             ( zeichen = grossesAE ) OR
  470.             ( zeichen = grossesOE ) OR
  471.             ( zeichen = grossesUE ) OR
  472.             ( zeichen = SZ        ));
  473.  
  474.      zeichen  EQU  12
  475.      RETURN   EQU  zeichen + 2
  476.  
  477.      IsUmlaut:
  478.        moveq    #0, d1          ; Default: FALSE
  479.        move.b   zeichen(a6), d0 ; fuer schnellen Zugriff
  480.        subi.b   #'ü', d0        ; zeichen = ü ?
  481.        blo.s    return          ; B: ueberhaupt kein Sonderzeichen
  482.        beq.s    true            ; B: ist ü
  483.        subq.b   #'ä'-'ü', d0    ; zeichen = ä ?
  484.        beq.s    true            ; B: ja
  485.        subi.b   #'Ä'-'ä', d0    ; zeichen = Ä ?
  486.        beq.s    true            ; B: ja
  487.        subq.b   #'ö'-'Ä', d0    ; zeichen = ö ?
  488.        beq.s    true            ; B: ja
  489.        subq.b   #'Ö'-'ö', d0    ; zeichen = Ö ?
  490.        beq.s    true            ; B: ja
  491.        subq.b   #'Ü'-'Ö', d0    ; zeichen = Ü ?
  492.        beq.s    true            ; B: ja
  493.        subi.b   #'ß'-'Ü', d0    ; zeichen = ß ?  *** subi.b #$E1-'Ü', d0
  494.        bne.s    return          ; B: kein Umlaut
  495.      true:
  496.        moveq    #1, d1
  497.      return:
  498.        move.b   d1, RETURN(a6)
  499. *)
  500.      INLINE( 7200H );
  501.      INLINE( 102EH, 000CH );
  502.      INLINE( 0400H, 0081H );
  503.      INLINE( 6520H );
  504.      INLINE( 671CH );
  505.      INLINE( 5700H );
  506.      INLINE( 6718H );
  507.      INLINE( 0400H, 000AH );
  508.      INLINE( 6712H );
  509.      INLINE( 5D00H );
  510.      INLINE( 670EH );
  511.      INLINE( 5B00H );
  512.      INLINE( 670AH );
  513.      INLINE( 5300H );
  514.      INLINE( 6706H );
  515.      INLINE( 0400H,0004H );  (*** INLINE( 0400H,0047H *)
  516.      INLINE( 6602H );
  517.      INLINE( 7201H );
  518.      INLINE( 1D41H, 000EH );
  519.  
  520.    END  IsUmlaut;
  521.  
  522.  
  523. (* --------------------------------------------------------------------------*)
  524.  
  525. PROCEDURE  IsSmallGerman ((* EIN/ -- *)  zeichen : CHAR ): BOOLEAN;
  526. (*T*)
  527.    BEGIN
  528. (*   RETURN(( 'a' <= zeichen ) & ( zeichen <= 'z' ) OR
  529.             ( zeichen = kleinesAE                 ) OR
  530.             ( zeichen = kleinesOE                 ) OR
  531.             ( zeichen = kleinesUE                 ) OR
  532.             ( zeichen = SZ                        ));
  533.  
  534.      zeichen  EQU  12
  535.      RETURN   EQU  zeichen + 2
  536.  
  537.      IsSmallGerman:
  538.        moveq    #0, d1          ; Default: FALSE
  539.        move.b   zeichen(a6), d0 ; fuer schnellen Zugriff
  540.        cmpi.b   #'a', d0        ; zeichen >= 'a' ?
  541.        blo.s    return          ; B: nein, weder Buchstabe noch Umlaut
  542.        cmpi.b   #'z', d0        ; Kleinbuchstabe ?
  543.        bls.s    true            ; B: ja, geritzt
  544.        subi.b   #'ü', d0        ; zeichen = ü ?
  545.        blo.s    return          ; B: ueberhaupt kein Umlaut
  546.        beq.s    true            ; B: ist ü
  547.        subq.b   #'ä'-'ü', d0    ; zeichen = ä ?
  548.        beq.s    true            ; B: jo
  549.        subi.b   #'ö'-'ä', d0    ; zeichen = ö ?
  550.        beq.s    true            ; B: ja
  551.        subi.b   #'ß'-'ö', d0    ; zeichen = ß ?  *** subi.b #$E1-'ö', d0 *
  552.        bne.s    return          ; kein Umlaut
  553.      true:
  554.        moveq    #1, d1          ; ist kleiner Umlaut oder Buchstabe
  555.      return:
  556.        move.b   d1, RETURN(a6)
  557. *)
  558.      INLINE( 7200H );
  559.      INLINE( 102EH, 000CH );
  560.      INLINE( 0C00H, 0061H );
  561.      INLINE( 6520H );
  562.      INLINE( 0C00H, 007AH );
  563.      INLINE( 6318H );
  564.      INLINE( 0400H, 0081H );
  565.      INLINE( 6514H );
  566.      INLINE( 6710H );
  567.      INLINE( 5700H );
  568.      INLINE( 670CH );
  569.      INLINE( 0400H, 0010H );
  570.      INLINE( 6706H );
  571.      INLINE( 0400H, 000AH ); (*** INLINE( 0400H, 004DH ); *)
  572.      INLINE( 6602H );
  573.      INLINE( 7201H );
  574.      INLINE( 1D41H, 000EH );
  575.    END  IsSmallGerman;
  576.  
  577. (* --------------------------------------------------------------------------*)
  578.  
  579. PROCEDURE  IsBigGerman ((* EIN/ -- *)  zeichen : CHAR ): BOOLEAN;
  580. (*T*)
  581.    BEGIN
  582. (*   RETURN(( 'A' <= zeichen ) & ( zeichen <= 'Z' ) OR
  583.             ( zeichen = grossesAE                 ) OR
  584.             ( zeichen = grossesOE                 ) OR
  585.             ( zeichen = grossesUE                 ));
  586.  
  587.      zeichen  EQU  12
  588.      RETURN   EQU  zeichen + 2
  589.  
  590.      IsBigGerman:
  591.        moveq    #0, d1          ; Default: FALSE
  592.        move.b   zeichen(a6), d0 ; fuer schnellen Zugriff
  593.        cmpi.b   #'A', d0        ; zeichen >= 'A' ?
  594.        blo.s    ende            ; B: nein, weder Buchstabe noch Umlaut
  595.        cmpi.b   #'Z', d0        ; Grossbuchstabe ?
  596.        bls.s    true            ; B: ja, geritzt
  597.        subi.b   #'Ä', d0        ; zeichen = Ä ?
  598.        blo.s    ende            ; B: ueberhaupt kein Umlaut
  599.        beq.s    true            ; B: ist ü
  600.        subi.b   #'Ö'-'Ä', d0    ; zeichen = Ö ?
  601.        beq.s    true            ; B: jo
  602.        subq.b   #'Ü'-'Ö', d0    ; zeichen = Ü ?
  603.        bne.s    ende            ; kein Umlaut
  604.      true:
  605.        moveq    #1, d1          ; ist grosser Umlaut oder Buchstabe
  606.      ende:
  607.        move.b   d1, RETURN(a6)
  608. *)
  609.      INLINE( 7200H );
  610.      INLINE( 102EH, 000CH );
  611.      INLINE( 0C00H, 0041H );
  612.      INLINE( 651AH );
  613.      INLINE( 0C00H, 005AH );
  614.      INLINE( 6312H );
  615.      INLINE( 0400H, 008EH );
  616.      INLINE( 650EH );
  617.      INLINE( 670AH );
  618.      INLINE( 0400H, 000BH );
  619.      INLINE( 6704H );
  620.      INLINE( 5300H );
  621.      INLINE( 6602H );
  622.      INLINE( 7201H );
  623.      INLINE( 1D41H, 000EH );
  624.    END  IsBigGerman;
  625.  
  626. (* --------------------------------------------------------------------------*)
  627.  
  628. PROCEDURE  IsGerman ((* EIN/ -- *)  zeichen : CHAR ): BOOLEAN;
  629. (*T*)
  630.    BEGIN
  631. (*   RETURN(( 'A' <= zeichen ) & ( zeichen <= 'Z' ) OR
  632.             ( 'a' <= zeichen ) & ( zeichen <= 'z' ) OR
  633.             ( zeichen = kleinesAE                 ) OR
  634.             ( zeichen = kleinesOE                 ) OR
  635.             ( zeichen = kleinesUE                 ) OR
  636.             ( zeichen = grossesAE                 ) OR
  637.             ( zeichen = grossesOE                 ) OR
  638.             ( zeichen = grossesUE                 ) OR
  639.             ( zeichen = SZ                        ));
  640.  
  641.      zeichen  EQU  12
  642.      RETURN   EQU  zeichen + 2
  643.  
  644.      IsGerman:
  645.        moveq    #0, d1          ; Default: FALSE
  646.        move.b   zeichen(a6), d2 ; fuer schnellen Zugriff
  647.        move.b   d2, d0
  648.        andi.b   #%11011111, d2  ; A = a
  649.        cmpi.b   #'A', d2        ; zeichen < 'A' ?
  650.        blo.s    ende            ; B: ja, kein Buchstabe
  651.        cmpi.b   #'Z', d2        ; zeichen <= 'Z' ?
  652.        bls.s    true            ; B: ja, Buchstabe
  653.        subi.b   #'ü', d0        ; zeichen = ü ?
  654.        blo.s    ende            ; B: ueberhaupt kein Sonderzeichen
  655.        beq.s    true            ; B: ist ü
  656.        subq.b   #'ä'-'ü', d0    ; zeichen = ä ?
  657.        beq.s    true            ; B: ja
  658.        subi.b   #'Ä'-'ä', d0    ; zeichen = Ä ?
  659.        beq.s    true            ; B: ja
  660.        subq.b   #'ö'-'Ä', d0    ; zeichen = ö ?
  661.        beq.s    true            ; B: ja
  662.        subq.b   #'Ö'-'ö', d0    ; zeichen = Ö ?
  663.        beq.s    true            ; B: ja
  664.        subq.b   #'Ü'-'Ö', d0    ; zeichen = Ü ?
  665.        beq.s    true            ; B: ja
  666.        subi.b   #'ß'-'Ü', d0    ; zeichen = ß ?  *** subi.b #$E1-'Ü', d0
  667.        bne.s    ende            ; B: kein Umlaut
  668.      true:
  669.        moveq    #1, d1          ; sonst TRUE
  670.      ende:
  671.        move.b   d1, RETURN(a6)
  672. *)
  673.      INLINE( 7200H );
  674.      INLINE( 142EH, 000CH );
  675.      INLINE( 1002H );
  676.      INLINE( 0202H, 00DFH );
  677.      INLINE( 0C02H, 0041H );
  678.      INLINE( 652CH );
  679.      INLINE( 0C02H, 005AH );
  680.      INLINE( 6324H );
  681.      INLINE( 0400H, 0081H );
  682.      INLINE( 6520H );
  683.      INLINE( 671CH );
  684.      INLINE( 5700H );
  685.      INLINE( 6718H );
  686.      INLINE( 0400H, 000AH );
  687.      INLINE( 6712H );
  688.      INLINE( 5D00H );
  689.      INLINE( 670EH );
  690.      INLINE( 5B00H );
  691.      INLINE( 670AH );
  692.      INLINE( 5300H );
  693.      INLINE( 6706H );
  694.      INLINE( 0400H,0004H );  (*** INLINE( 0400H,0047H )*)
  695.      INLINE( 6602H );
  696.      INLINE( 7201H );
  697.      INLINE( 1D41H, 000EH );
  698.  
  699.    END  IsGerman;
  700.  
  701. (* --------------------------------------------------------------------------*)
  702.  
  703. PROCEDURE  IsSmallASCIIUmlaut ((* EIN/ -- *)  zeichen : CHAR ): BOOLEAN;
  704. (*T*)
  705.    BEGIN
  706.      RETURN(( kleinesASCIIae <= zeichen ) & ( zeichen <= ASCIIsz ));
  707.    END  IsSmallASCIIUmlaut;
  708.  
  709. (* --------------------------------------------------------------------------*)
  710.  
  711. PROCEDURE  IsBigASCIIUmlaut ((* EIN/ -- *)  zeichen : CHAR ): BOOLEAN;
  712. (*T*)
  713.    BEGIN
  714.      RETURN(( grossesASCIIae <= zeichen ) & ( zeichen <= grossesASCIIue ));
  715.    END  IsBigASCIIUmlaut;
  716.  
  717. (* --------------------------------------------------------------------------*)
  718.  
  719. PROCEDURE  IsASCIIUmlaut ((* EIN/ -- *)  zeichen : CHAR ): BOOLEAN;
  720. (*T*)
  721.    BEGIN
  722. (*   RETURN(( kleinesASCIIae <= zeichen ) & ( zeichen <= ASCIIsz ) OR
  723.             ( grossesASCIIae <= zeichen ) & ( zeichen <= grossesASCIIue ));
  724.  
  725.      zeichen  EQU  12
  726.      RETURN   EQU  zeichen + 2
  727.  
  728.      IsASCIIUmlaut:
  729.        moveq    #0, d1          ; Default: FALSE
  730.        move.b   zeichen(a6), d0 ; fuer schnellen Zugriff
  731.        cmpi.b   #'~', d0        ; zeichen = sz ?
  732.        beq.s    true            ; B: ja, ist ASCII-Umlaut
  733.        andi.b   #%11011111, d0  ; klein -> gross
  734.        subi.b   #'[', d0        ; zeichen < grossesASCIIae ?
  735.        blo.s    ende            ; B: ja, kein ASCII-Umlaut
  736.        subq.b   #']'-'[', d0    ; zeichen > grossesASCIIue ?
  737.        bhi.s    ende            ; B: ja, kein ASCII-Umlaut
  738.      true:
  739.        moveq    #1, d1          ; sonst TRUE
  740.      ende:
  741.        move.b   d1, RETURN(a6)
  742. *)
  743.      INLINE( 7200H );
  744.      INLINE( 102EH,000CH );
  745.      INLINE( 0C00H,007EH );
  746.      INLINE( 670EH );
  747.      INLINE( 0200H,00DFH );
  748.      INLINE( 0400H,005BH );
  749.      INLINE( 6506H );
  750.      INLINE( 5500H );
  751.      INLINE( 6202H );
  752.      INLINE( 7201H );
  753.      INLINE( 1D41H,000EH );
  754.    END  IsASCIIUmlaut;
  755.  
  756. (* --------------------------------------------------------------------------*)
  757.  
  758. PROCEDURE  IsSmallASCIIGerman ((* EIN/ -- *)  zeichen : CHAR ): BOOLEAN;
  759. (*T*)
  760.    BEGIN
  761.      RETURN(( 'a' <= zeichen ) & ( zeichen <= ASCIIsz ));
  762.    END  IsSmallASCIIGerman;
  763.  
  764. (* --------------------------------------------------------------------------*)
  765.  
  766. PROCEDURE  IsBigASCIIGerman ((* EIN/ -- *)  zeichen : CHAR ): BOOLEAN;
  767. (*T*)
  768.    BEGIN
  769.      RETURN(( 'A' <= zeichen ) & ( zeichen <= grossesASCIIue ));
  770.    END  IsBigASCIIGerman;
  771.  
  772. (* --------------------------------------------------------------------------*)
  773.  
  774. PROCEDURE  IsASCIIGerman ((* EIN/ -- *)  zeichen : CHAR ): BOOLEAN;
  775. (*T*)
  776.    BEGIN
  777. (*   RETURN((( 'a' <= zeichen ) & ( zeichen <= ASCIIsz        ))  OR
  778.             (( 'A' <= zeichen ) & ( zeichen <= grossesASCIIue )));
  779.  
  780.      zeichen  EQU  12
  781.      RETURN   EQU  zeichen + 2
  782.  
  783.      IsASCIIGerman:
  784.        moveq    #0, d1          ; Default: FALSE
  785.        move.b   zeichen(a6), d0 ; fuer schnellen Zugriff
  786.        cmpi.b   #'~', d0        ; zeichen = sz ?
  787.        beq.s    true            ; B: ja,
  788.        andi.b   #%11011111, d0  ; klein -> gross
  789.        cmpi.b   #'A', d0        ; zeichen < 'A' ?
  790.        blo.s    ende            ; B: ja, kein deut. Buchst.
  791.        cmpi.b   #']', d0        ; zeichen > grossesASCIIue ?
  792.        bhi.s    ende            ; B: ja, kein deut. Buchst.
  793.      true:
  794.        moveq    #1, d1          ; sonst TRUE
  795.      ende:
  796.        move.b   d1, RETURN(a6)
  797. *)
  798.      INLINE( 7200H );
  799.      INLINE( 102EH,000CH );
  800.      INLINE( 0C00H,007EH );
  801.      INLINE( 6710H );
  802.      INLINE( 0200H,00DFH );
  803.      INLINE( 0C00H,0041H );
  804.      INLINE( 6508H );
  805.      INLINE( 0C00H,005DH );
  806.      INLINE( 6202H );
  807.      INLINE( 7201H );
  808.      INLINE( 1D41H,000EH );
  809.    END  IsASCIIGerman;
  810.  
  811. (* --------------------------------------------------------------------------*)
  812.  
  813. PROCEDURE  IsOneOfSet ((* EIN/ -- *)  zeichen : CHAR;
  814.                        (* EIN/ -- *)  charSet : ARRAY OF CHAR ): BOOLEAN;
  815. (*T*)
  816. (* VAR  Index : CARDINAL; *)
  817.  
  818.    BEGIN
  819. (*   Index := 0;
  820.      LOOP
  821.        IF   ( Index > VAL( CARDINAL, HIGH( charSet ))) OR
  822.             ( charSet[ Index ] = NUL                 )
  823.        THEN
  824.           RETURN( FALSE );
  825.        ELSIF  charSet[ Index ] = zeichen  THEN
  826.           RETURN( TRUE );
  827.        END;
  828.        INC( Index );
  829.      END; (* LOOP *)
  830.  
  831.   Hier lohnt sich die Assemblercodierung...
  832.  
  833.      charSet EQU 12
  834.      HIGH    EQU charSet + 4
  835.      zeichen EQU HIGH + 2
  836.      RETURN  EQU zeichen + 2
  837.  
  838.      IsOneOfSet:
  839.        moveq   #0, d3
  840.        movea.l charSet(a6), a0
  841.        move.w  HIGH(a6), d0
  842.        move.b  zeichen(a6), d1
  843.      setlp:
  844.        move.b  (a0)+, d2
  845.        beq.s   ende
  846.        cmp.b   d1, d2
  847.        dbeq    d0, setlp
  848.        bne.s   ende
  849.        moveq   #1, d3
  850.      ende:
  851.        move.b  d3, RETURN(a6)
  852. *)
  853.      INLINE( 7600H );
  854.      INLINE( 206EH,000CH );
  855.      INLINE( 302EH,0010H );
  856.      INLINE( 122EH,0012H );
  857.      INLINE( 1418H );
  858.      INLINE( 670AH );
  859.      INLINE( 0B401H );
  860.      INLINE( 57C8H,0FFF8H );
  861.      INLINE( 6602H );
  862.      INLINE( 7601H );
  863.      INLINE( 1D43H,0014H );
  864.  
  865.    END  IsOneOfSet;
  866.  
  867. (* --------------------------------------------------------------------------*)
  868.  
  869. PROCEDURE  LowerCase ((* EIN/ -- *) zeichen : CHAR ): CHAR;
  870. (*T*)
  871.    BEGIN
  872. (*   IF   ('A' <= zeichen ) & ( zeichen <= 'Z')  THEN
  873.         RETURN( CHR( ORD( zeichen ) + 20H ));
  874.      ELSE
  875.         RETURN( zeichen );
  876.      END;
  877.  
  878.      zeichen EQU  12
  879.      RETURN  EQU  zeichen + 2
  880.  
  881.      LowerCase:
  882.        move.b  zeichen(a6), d0
  883.        cmpi.b  #'A', d0
  884.        blo.s   ende
  885.        cmpi.b  #'Z', d0
  886.        bhi.s   ende
  887.        ori.b   #%00100000, d0
  888.      ende:
  889.        move.b  d0, RETURN(a6)
  890. *)
  891.      INLINE( 102EH,000CH );
  892.      INLINE( 0C00H,0041H );
  893.      INLINE( 650AH );
  894.      INLINE( 0C00H,005AH );
  895.      INLINE( 6204H );
  896.      INLINE( 0000H,0020H );
  897.      INLINE( 1D40H,000EH );
  898.    END  LowerCase;
  899.  
  900. (* --------------------------------------------------------------------------*)
  901.  
  902. PROCEDURE  LowerCaseGerman ((* EIN/ -- *) zeichen : CHAR ): CHAR;
  903. (*T*)
  904.    BEGIN
  905. (*   IF   ('A' <= zeichen ) & ( zeichen <= 'Z')  THEN
  906.         RETURN( CHR( ORD( zeichen ) + 20H ));
  907.      ELSIF  zeichen >= grossesAE  THEN
  908.         IF    zeichen = grossesAE  THEN
  909.            RETURN( kleinesAE );
  910.         ELSIF zeichen = grossesOE  THEN
  911.            RETURN( kleinesOE );
  912.         ELSIF zeichen = grossesUE  THEN
  913.            RETURN( kleinesUE );
  914.         END;
  915.      END;
  916.  
  917.      RETURN( zeichen );
  918.  
  919.      zeichen  EQU  12
  920.      RETURN   EQU  zeichen + 2
  921.  
  922.      LowerCaseGerman:
  923.        move.b  zeichen(a6), d0
  924.        cmpi.b  #'A', d0
  925.        blo.s   ende
  926.        cmpi.b  #'Z', d0
  927.        bhi.s   tstae
  928.        ori.b   #%00100000, d0
  929.        bra.s   ende
  930.      tstae:
  931.        cmpi.b  #'Ä', d0
  932.        blo.s   ende
  933.        bne.s   tstoe
  934.        move.b  #'ä', d0
  935.        bra.s   ende
  936.      tstoe:
  937.        cmpi.b  #'Ö', d0
  938.        bne.s   tstue
  939.        move.b  #'ö', d0
  940.        bra.s   ende
  941.      tstue:
  942.        cmpi.b  #'Ü', d0
  943.        bne.s   ende
  944.        move.b  #'ü', d0
  945.      ende:
  946.        move.b  d0, RETURN(a6)
  947. *)
  948.      INLINE( 102EH,000CH );
  949.      INLINE( 0C00H,0041H );
  950.      INLINE( 6530H );
  951.      INLINE( 0C00H,005AH );
  952.      INLINE( 6206H );
  953.      INLINE( 0000H,0020H );
  954.      INLINE( 6024H );
  955.      INLINE( 0C00H,008EH );
  956.      INLINE( 651EH );
  957.      INLINE( 6606H );
  958.      INLINE( 103CH,0084H );
  959.      INLINE( 6016H );
  960.      INLINE( 0C00H,0099H );
  961.      INLINE( 6606H );
  962.      INLINE( 103CH,0094H );
  963.      INLINE( 600AH );
  964.      INLINE( 0C00H,009AH );
  965.      INLINE( 6604H );
  966.      INLINE( 103CH,0081H );
  967.      INLINE( 1D40H,000EH );
  968.    END  LowerCaseGerman;
  969.  
  970. (* --------------------------------------------------------------------------*)
  971.  
  972. PROCEDURE  LowerCaseASCIIGerman ((* EIN/ -- *) zeichen : CHAR ): CHAR;
  973. (*T*)
  974.    BEGIN
  975. (*   IF   ('A' <= zeichen ) & ( zeichen <= grossesASCIIue )  THEN
  976.         RETURN( CHR( ORD( zeichen ) + 20H ));
  977.      ELSE
  978.         RETURN( zeichen );
  979.      END;
  980.  
  981.      zeichen EQU 12
  982.      RETURN  EQU zeichen + 2
  983.  
  984.      LowerCaseASCIIGerman:
  985.        move.b  zeichen(a6), d0
  986.        cmpi.b  #'A', d0
  987.        blo.s   ende
  988.        cmpi.b  #']', d0
  989.        bhi.s   ende
  990.        ori.b   #%00100000, d0
  991.      ende:
  992.        move.b  d0, RETURN(a6)
  993. *)
  994.      INLINE( 102EH,000CH );
  995.      INLINE( 0C00H,0041H );
  996.      INLINE( 650AH );
  997.      INLINE( 0C00H,005DH );
  998.      INLINE( 6204H );
  999.      INLINE( 0000H,0020H );
  1000.      INLINE( 1D40H,000EH );
  1001.    END  LowerCaseASCIIGerman;
  1002.  
  1003. (* --------------------------------------------------------------------------*)
  1004.  
  1005. PROCEDURE  CAPGerman ((* EIN/ -- *) zeichen : CHAR ): CHAR;
  1006. (*T*)
  1007.    BEGIN
  1008. (*   IF   zeichen >= kleinesUE   THEN
  1009.         IF    zeichen = kleinesUE  THEN
  1010.            RETURN( grossesUE );
  1011.         ELSIF zeichen = kleinesAE  THEN
  1012.            RETURN( grossesAE );
  1013.         ELSIF zeichen = kleinesOE  THEN
  1014.            RETURN( grossesOE );
  1015.         END;
  1016.      END;
  1017.  
  1018.      RETURN( CAP( zeichen ));
  1019.  
  1020.      zeichen  EQU  12
  1021.      RETURN   EQU  zeichen + 2
  1022.  
  1023.      CAPGerman:
  1024.        move.b  zeichen(a6), d0
  1025.        cmpi.b  #'ü', d0         ; zeichen >= kleinesUE ?
  1026.        blo.s   cap              ; B: nein kein kl. Uml.
  1027.        bne.s   tstae            ; B: ist nicht kleinesUE
  1028.        move.b  #'Ü', d0         ; sonst grossesUE
  1029.        bra.s   ende             ; fertig
  1030.      tstae:
  1031.        cmpi.b  #'ä', d0         ; zeichen = kleinesAE ?
  1032.        bne.s   tstoe            ; B: nein
  1033.        move.b  #'Ä', d0         ; sonst zeichen := grossesAE
  1034.        bra.s   ende
  1035.      tstoe:
  1036.        cmpi.b  #'ö', d0         ; zeichen = kleinesOE ?
  1037.        bne.s   ende             ; B: nein, weder kl. Uml noch kl. Buchst.
  1038.        move.b  #'Ö', d0         ; zeichen := grossesOE
  1039.        bra.s   ende
  1040.      cap:
  1041.        cmpi.b  #'a', d0         ; zeichen >= 'a' ?
  1042.        blo.s   ende             ; B: nein, kein Kleinbuchst.
  1043.        cmpi.b  #'z', d0         ; zeichen <= 'z' ?
  1044.        bhi.s   ende             ; B: nein, kein Kleinbuchst.
  1045.        andi.b  #%11011111, d0   ; klein -> gross
  1046.      ende:
  1047.        move.b  d0, RETURN(a6)
  1048. *)
  1049.      INLINE( 102EH,000CH );
  1050.      INLINE( 0C00H,0081H );
  1051.      INLINE( 6520H );
  1052.      INLINE( 6606H );
  1053.      INLINE( 103CH,009AH );
  1054.      INLINE( 6028H );
  1055.      INLINE( 0C00H,0084H );
  1056.      INLINE( 6606H );
  1057.      INLINE( 103CH,008EH );
  1058.      INLINE( 601CH );
  1059.      INLINE( 0C00H,0094H );
  1060.      INLINE( 6616H );
  1061.      INLINE( 103CH,0099H );
  1062.      INLINE( 6010H );
  1063.      INLINE( 0C00H,0061H );
  1064.      INLINE( 650AH );
  1065.      INLINE( 0C00H,007AH );
  1066.      INLINE( 6204H );
  1067.      INLINE( 0200H,00DFH );
  1068.      INLINE( 1D40H,000EH );
  1069.    END  CAPGerman;
  1070.  
  1071. (* --------------------------------------------------------------------------*)
  1072.  
  1073. PROCEDURE  CAPGermanASCII ((* EIN/ -- *) zeichen : CHAR ): CHAR;
  1074. (*T*)
  1075.    BEGIN
  1076. (*   IF  ( zeichen >= 'a' ) & ( zeichen <= kleinesASCIIue )  THEN
  1077.         RETURN( CHR( ORD( zeichen ) - 20H ));
  1078.      ELSE
  1079.         RETURN( zeichen );
  1080.      END;
  1081.  
  1082.      zeichen  EQU  12
  1083.      RETURN   EQU  zeichen + 2
  1084.  
  1085.      CAPGermanASCII:
  1086.        move.b  zeichen(a6), d0
  1087.        cmpi.b  #'a', d0
  1088.        blo.s   ende
  1089.        cmpi.b  #'}', d0
  1090.        bhi.s   ende
  1091.        andi.b  #%11011111, d0
  1092.      ende:
  1093.        move.b  d0, RETURN(a6)
  1094. *)
  1095.      INLINE( 102EH,000CH );
  1096.      INLINE( 0C00H,0061H );
  1097.      INLINE( 650AH );
  1098.      INLINE( 0C00H,007DH );
  1099.      INLINE( 6204H );
  1100.      INLINE( 0200H,00DFH );
  1101.      INLINE( 1D40H,000EH );
  1102.    END  CAPGermanASCII;
  1103.  
  1104. (* --------------------------------------------------------------------------*)
  1105.  
  1106. PROCEDURE  ToAtariGerman ((* EIN/ -- *) zeichen : CHAR ): CHAR;
  1107. (*T*)
  1108.    BEGIN
  1109.      IF    ( kleinesASCIIae <= zeichen ) & ( zeichen <= ASCIIsz )  THEN
  1110.         RETURN( LcAtari[ ORD( zeichen ) - ORD( kleinesASCIIae ) ] );
  1111.      ELSIF ( grossesASCIIae <= zeichen ) & ( zeichen <= grossesASCIIue )  THEN
  1112.         RETURN( UcAtari[ ORD( zeichen ) - ORD( grossesASCIIae ) ] );
  1113.      ELSIF zeichen = ASCIIParagraph  THEN
  1114.         RETURN( Paragraph );
  1115.      ELSE
  1116.         RETURN( zeichen );
  1117.      END;
  1118.  
  1119.    END  ToAtariGerman;
  1120.  
  1121. (* --------------------------------------------------------------------------*)
  1122.  
  1123. PROCEDURE  ToASCIIGerman ((* EIN/ -- *) zeichen : CHAR ): CHAR;
  1124. (*T*)
  1125.    BEGIN
  1126.      CASE  zeichen  OF
  1127.          kleinesAE : RETURN( kleinesASCIIae );
  1128.        | kleinesOE : RETURN( kleinesASCIIoe );
  1129.        | kleinesUE : RETURN( kleinesASCIIue );
  1130.        | grossesAE : RETURN( grossesASCIIae );
  1131.        | grossesOE : RETURN( grossesASCIIoe );
  1132.        | grossesUE : RETURN( grossesASCIIue );
  1133.        | SZ        : RETURN( ASCIIsz );
  1134.       ELSE
  1135.          IF  zeichen = Paragraph  THEN    (* Paragraph extra, sonst wird die *)
  1136.             RETURN( ASCIIParagraph );     (* Sprungtabelle des CASE-Konstruk-*)
  1137.          ELSE                             (* tes zu gross.                   *)
  1138.             RETURN( zeichen );
  1139.          END; (* IF *)
  1140.      END; (* CASE *)
  1141.  
  1142.    END  ToASCIIGerman;
  1143.  
  1144. (* --------------------------------------------------------------------------*)
  1145.  
  1146. PROCEDURE  DigitToCard ((* EIN/ -- *)  digit : CHAR ): CARDINAL;
  1147. (*T*)
  1148.    BEGIN
  1149.      RETURN( ORD( digit ) - ORD('0') );
  1150.    END  DigitToCard;
  1151.  
  1152. (* --------------------------------------------------------------------------*)
  1153.  
  1154. PROCEDURE  CardToDigit ((* EIN/ -- *)  card : CARDINAL ): CHAR;
  1155. (*T*)
  1156.    BEGIN
  1157.      RETURN( CHR( card + VAL( CARDINAL, ORD('0'))));
  1158.    END  CardToDigit;
  1159.  
  1160. (* --------------------------------------------------------------------------*)
  1161.  
  1162. PROCEDURE  CardToHexDigit ((* EIN/ -- *) hexvalue : CARDINAL ): CHAR;
  1163. (*T*)
  1164.    BEGIN
  1165.      RETURN( hexdigits[ hexvalue MOD 16 ] );
  1166.    END  CardToHexDigit;
  1167.  
  1168. (* --------------------------------------------------------------------------*)
  1169.  
  1170. PROCEDURE  HexDigitToCard ((* EIN/ -- *) hexdigit : CHAR ): CARDINAL;
  1171. (*T*)
  1172.    BEGIN
  1173.      IF  hexdigit <= '9'  THEN
  1174.        RETURN( ORD( hexdigit ) - ORD('0'));
  1175.      ELSE
  1176.        RETURN( ORD( CAP( hexdigit )) - ORD('A') + 10 );
  1177.      END;
  1178.    END  HexDigitToCard;
  1179.  
  1180. (*===========================================================================*)
  1181.  
  1182.  BEGIN   (* statt Konstanten, sonst nicht indizierbar...@$!\#  *)
  1183.  
  1184.    LcAtari := 'äöüß';
  1185.    UcAtari := 'ÄÖÜ';
  1186.  
  1187.    hexdigits := '0123456789ABCDEF';
  1188.  
  1189. END  Chars.
  1190.